COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	program pcnrac(output)
C00008 ENDMK
C⊗;
program pcnrac(output);
var
p,c,n,pp,cc,a,b,d,d1,d2
	:integer;
sx0,sx1,sx2,sx3
	:array[1:8] of real;
ex0,ex1,ex2,ex3,ey0,ey1,ey2,ey3,ex0w,ex1w,ey0w,ey2w
	:array [0:26,-1:14,-1:8] of real;
xaction,yaction
	:array [0:26,-1:14,-1:8] of integer;

function max(x,y:integer):integer;
	begin
	if x>y then max:=x else max:=y;
	end;

procedure apply(d:integer);
	begin
	if pp>6 then pp:=pp-d
	else if (d=1) and (cc>0) then cc:=cc-1
	else if pp>0 then pp:=max(pp-d,0)
	else cc:=max(cc-1,0)
	end;

begin
for n:=-1 to 0 do
	for p:=0 to 26 do
		for c:=0 to 14 do
			begin
			ex0[p,c,n]:=-1.0;
			ex1[p,c,n]:=-1.0;
			ex2[p,c,n]:=-1.0;
			ex3[p,c,n]:=-1.0;
			end;
for n:=1 to 8 do
	begin
 	ey0[0,0,n]:=1.0;
	ey1[0,0,n]:=1.0;
	ey2[0,0,n]:=1.0;
	ey3[0,0,n]:=1.0;
	end;
for p:=0 to 26 do
for c:=0 to 14 do
if p+c > 0 then
	begin
	for n:=1 to 8 do
		begin
		sx0[n]:=0;
		sx1[n]:=0;
		sx2[n]:=0;
		sx3[n]:=0;
		end;
	for d1:=2 to 6 do
	for d2:=1 to d1-1 do
		begin
		pp:=p;cc:=c;
		apply(d1);
		apply(d2);
		for n:=1 to 8 do
			begin
			sx0[n]:=sx0[n]+2*ey0[pp,cc,n];
			sx1[n]:=sx1[n]+2*ey1[pp,cc,n];
			sx2[n]:=sx2[n]+2*ey2[pp,cc,n];
			sx3[n]:=sx3[n]+2*ey3[pp,cc,n];
			end;
		end;
	for d1:=1 to 6 do
		begin
		pp:=p;cc:=c;
		apply(d1);
		apply(d1);
		apply(d1);
		apply(d1);
		for n:=1 to 8 do
			begin
			sx0[n]:=sx0[n]+ey0[pp,cc,n];
			sx1[n]:=sx1[n]+ey1[pp,cc,n];
			sx2[n]:=sx2[n]+ey2[pp,cc,n];
			sx3[n]:=sx3[n]+ey2[pp,cc,n];
			end
		end;
	for n:=1 to 8 do
		begin
		ex0[p,c,n]:=sx0[n]/36.0;
		ex1[p,c,n]:=sx1[n]/36.0;
		ex2[p,c,n]:=sx2[n]/36.0;
		ex3[p,c,n]:=sx3[n]/36.0;
		ex0w[p,c,n]:=ex0[p,c,n];
		ex1w[p,c,n]:=ex1[p,c,n];
		if ex2[p,c,n]<0.0 then xaction[p,c,n]:=0 else xaction[p,c,n]:=1;
		if 2*ex2[p,c,n]>ex1[p,c,n]then (*redouble*)
			begin
			xaction[p,c,n]:=3;
			ex0[p,c,n]:=2*ex2[p,c,n];
			ex1[p,c,n]:=2*ex2[p,c,n];
			end
		else if 2*ex2[p,c,n]>ex0[p,c,n] then (*double*)
			begin
			xaction[p,c,n]:=2;
			ex0[p,c,n]:=2*ex2[p,c,n];
			end;
		if ex0[p,c,n]>1.0 then
			begin
			ex0[p,c,n]:=1.0;
			ex1[p,c,n]:=1.0;
			xaction[p,c,n]:=4;
			end
		end;
	for n:=1 to 8 do
		begin
		ey0[p,c,n]:=(5*ex0[p,c,n-1]+ex0[p,c,n-2])/6.0;
		ey1[p,c,n]:=(5*ex1[p,c,n-1]+ex1[p,c,n-2])/6.0;
		ey2[p,c,n]:=(5*ex2[p,c,n-1]+ex2[p,c,n-2])/6.0;
		ey3[p,c,n]:=(5*ex3[p,c,n-1]+ex3[p,c,n-2])/6.0;
		ey0w[p,c,n]:=ey0[p,c,n];
		ey2w[p,c,n]:=ey2[p,c,n];
		if ey1[p,c,n]>0 then yaction[p,c,n]:=0 else yaction[p,c,n]:=1;
		if 2*ey1[p,c,n]<ey2[p,c,n] then (*redouble*)
			begin
			yaction[p,c,n]:=3;
			ey0[p,c,n]:=2*ey1[p,c,n];
			ey2[p,c,n]:=2*ey1[p,c,n];
			end
		else if 2*ey1[p,c,n]<ey0[p,c,n] then (*double*)
			begin
			yaction[p,c,n]:=2;
			ey0[p,c,n]:=2*ey1[p,c,n];
			end;
		if ey0[p,c,n]<-1.0 then (*drop*)
			begin
			yaction[p,c,n]:=4;
			ey0[p,c,n]:=-1.0;
			ey2[p,c,n]:=-1.0;
			end
	       	end(*n*)
	end;(*p,c*)
writeln('  n  c  p  ex1w    ex0w    ex2     ex3    xaction   p');
for n:=2 to 8 do
	for c:=0 to 14 do
		for p:=1 to 25 do
		if(xaction[p-1,c,n]>0)and(xaction[p+1,c,n]<4) then
		writeln(n:3,c:3,p:3,ex1w[p,c,n]:8:3,ex0w[p,c,n]:8:3,ex2[p,c,n]:8:3,
		ex3[p,c,n]:8:3,	xaction[p,c,n]:3,(0.5*ex3[p,c,n]+0.5):8:3);
page;
writeln('  n  c  p  ey2w    ey0w    ey1     ey3    yaction   p');
for n:=2 to 8 do
	for c:=0 to 14 do
		for p:=1 to 25 do
		if(yaction[p+1,c,n]>0)and(yaction[p-1,c,n]<4) then
		writeln(n:3,c:3,p:3,ey2w[p,c,n]:8:3,ey0w[p,c,n]:8:3,ey1[p,c,n]:8:3,
		ey3[p,c,n]:8:3,	yaction[p,c,n]:3,(0.5*ey3[p,c,n]+0.5):8:3);
end.